<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html>
<head>
<title>eval.c</title>
<style type="text/css">
<!--
body.hl	{ background-color:#ffffff; }
pre.hl	{ color:#000000; background-color:#ffffff; font-size:10pt; font-family:'Courier New';}
.hl.num { color:#ff0000; }
.hl.esc { color:#ff22ff; }
.hl.str { color:#ff0000; }
.hl.dstr { color:#ff0000; }
.hl.slc { color:#0000ff; }
.hl.com { color:#0000ff; }
.hl.dir { color:#ff22ff; }
.hl.sym { color:#000000; }
.hl.line { color:#0000ff; }
.hl.mark	{ background-color:#ffffbb;}
.hl.kwa { color:#b26818; }
.hl.kwb { color:#00ff00; }
.hl.kwc { color:#b26818; }
.hl.kwd { color:#000000; }
//-->
</style>
</head>
<body class="hl">
<pre class="hl"><span class="hl com">/*</span>
<span class="hl com"> *  eval.c</span>
<span class="hl com"> *  scheme2</span>
<span class="hl com"> *</span>
<span class="hl com"> *  Created by Leo Katzenstein on 5/26/07.</span>
<span class="hl com"> *  Copyright 2007 __MyCompanyName__. All rights reserved.</span>
<span class="hl com"> *</span>
<span class="hl com"> */</span>

<span class="hl dir">#include</span> <span class="hl dstr">&quot;scheme.h&quot;</span><span class="hl dir"></span>

<span class="hl com">/*</span>
<span class="hl com"> * Evaluate a symbol by looking it up in the environment.</span>
<span class="hl com"> */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">evsym</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>sym<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">, *</span>e<span class="hl sym">;</span>
    <span class="hl kwa">for</span> <span class="hl sym">(</span> e <span class="hl sym">=</span> env<span class="hl sym">;</span> e<span class="hl sym">;</span> e <span class="hl sym">=</span> e<span class="hl sym">-&gt;</span>cdr <span class="hl sym">)</span>
    <span class="hl sym">{</span>
        <span class="hl kwa">for</span> <span class="hl sym">(</span> p <span class="hl sym">=</span> e<span class="hl sym">-&gt;</span>car<span class="hl sym">;</span> p<span class="hl sym">;</span> p <span class="hl sym">=</span> p<span class="hl sym">-&gt;</span>cdr <span class="hl sym">)</span>
            <span class="hl kwa">if</span> <span class="hl sym">(</span> p<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> sym <span class="hl sym">)</span>
                <span class="hl kwa">return</span> p<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>cdr<span class="hl sym">;</span>
    <span class="hl sym">}</span>
    <span class="hl kwd">pexp</span><span class="hl sym">(</span> sym <span class="hl sym">);</span>  <span class="hl com">/* need pname function */</span>
    <span class="hl kwd">error</span><span class="hl sym">(</span> <span class="hl str">&quot;attempt to take the value of an unbound variable&quot;</span> <span class="hl sym">);</span>
    <span class="hl kwa">return</span> NULL<span class="hl sym">;</span>  <span class="hl com">/* not reached, quiet the warning */</span>
<span class="hl sym">}</span>

<span class="hl com">/*</span>
<span class="hl com"> * Evaluate a (progn e1 e2 ... en)</span>
<span class="hl com"> * The evaluation is done by successively evaluating each of</span>
<span class="hl com"> * ei and returning the value of en.</span>
<span class="hl com"> *</span>
<span class="hl com"> * A major use for this is if the e1 through e(i-1) have side</span>
<span class="hl com"> * effects.</span>
<span class="hl com"> *</span>
<span class="hl com"> * The parameters are:</span>
<span class="hl com"> *   l, the list of remaining clauses,</span>
<span class="hl com"> *   a, the value of the last clause evaluated, and</span>
<span class="hl com"> *   env, the environment.</span>
<span class="hl com"> */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">evprogn</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>l<span class="hl sym">,</span> Pair <span class="hl sym">*</span>a<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span> NULL <span class="hl sym">==</span> l <span class="hl sym">)</span>
    <span class="hl kwa">return</span> a<span class="hl sym">;</span>
  a <span class="hl sym">=</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> l<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> env <span class="hl sym">);</span>
  <span class="hl kwa">return</span> <span class="hl kwd">evprogn</span><span class="hl sym">(</span> l<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> a<span class="hl sym">,</span> env <span class="hl sym">);</span>
<span class="hl sym">}</span>

<span class="hl com">/*</span>
<span class="hl com"> * Cond is relatively complex compared to the other primitives</span>
<span class="hl com"> * so for clarity the evaluation is separated out.</span>
<span class="hl com"> *</span>
<span class="hl com"> * cl is the list of cond clauses, each clause of the form</span>
<span class="hl com"> * (p e1 e2 ... en). p is evaluated and if non-nil then each</span>
<span class="hl com"> * of e1 through en is evaluated in turn, and the result</span>
<span class="hl com"> * returned is the value of en.</span>
<span class="hl com"> * If there are no terms e1 ... then the value returned is the</span>
<span class="hl com"> * value of p.</span>
<span class="hl com"> * If none of the clauses is selected nil is returned.</span>
<span class="hl com"> */</span>
Pair <span class="hl sym">*</span><span class="hl kwd">evcond</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>cl<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
  Pair <span class="hl sym">*</span>pv<span class="hl sym">;</span>          <span class="hl com">/* predicate value */</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span> NULL <span class="hl sym">==</span> cl <span class="hl sym">)</span>
    <span class="hl kwa">return</span> cl<span class="hl sym">;</span>

  <span class="hl com">/*</span>
<span class="hl com">   * Evaluate the first expression in the first clause.</span>
<span class="hl com">   *</span>
<span class="hl com">   * If the result is NULL, then evaluate the remaining clauses.</span>
<span class="hl com">   * Otherwise, the predicate evaluates to some non-null value,</span>
<span class="hl com">   * so evaluate the expressions in the remainder of the clause.</span>
<span class="hl com">   * This evaluation is essentially an evaluation of (progn ...).</span>
<span class="hl com">   */</span>

  pv <span class="hl sym">=</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> cl<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> env <span class="hl sym">);</span>
  <span class="hl kwa">if</span> <span class="hl sym">(</span> NULL <span class="hl sym">==</span> pv <span class="hl sym">)</span>
    <span class="hl kwa">return</span> <span class="hl kwd">evcond</span><span class="hl sym">(</span> cl<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> env <span class="hl sym">);</span>
  <span class="hl kwa">else</span>
    <span class="hl kwa">return</span> <span class="hl kwd">evprogn</span><span class="hl sym">(</span> cl<span class="hl sym">-&gt;</span>car<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> pv<span class="hl sym">,</span> env <span class="hl sym">);</span>

<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">eval</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>exp<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>f<span class="hl sym">, *</span>a<span class="hl sym">, *</span>v<span class="hl sym">;</span>
    <span class="hl com">/* case by case */</span>

    <span class="hl com">/* nil */</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span> exp <span class="hl sym">==</span> NULL <span class="hl sym">)</span>
      <span class="hl kwa">return</span> exp<span class="hl sym">;</span>
    <span class="hl com">/* nil is really quite special */</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span> exp <span class="hl sym">==</span> nil <span class="hl sym">)</span>
      <span class="hl kwa">return</span> NULL<span class="hl sym">;</span>

    <span class="hl com">/* number - numbers evaluate to themselves */</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span> <span class="hl kwd">is_number</span><span class="hl sym">(</span> exp <span class="hl sym">) )</span>
      <span class="hl kwa">return</span> exp<span class="hl sym">;</span>

    <span class="hl com">/* symbol - get the value from the atom (environment later) */</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span> <span class="hl kwd">is_symbol</span><span class="hl sym">(</span> exp <span class="hl sym">) )</span>
      <span class="hl kwa">return</span> <span class="hl kwd">evsym</span><span class="hl sym">(</span> exp<span class="hl sym">,</span> env <span class="hl sym">);</span>

    <span class="hl com">/* combination */</span>

    <span class="hl com">/* check for the special operators first */</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> quote <span class="hl sym">) {</span>         <span class="hl com">/* quote */</span>
      <span class="hl kwa">return</span> <span class="hl kwd">CADR</span><span class="hl sym">(</span>exp<span class="hl sym">);</span>
    <span class="hl sym">}</span> <span class="hl kwa">else if</span> <span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> cond <span class="hl sym">) {</span>   <span class="hl com">/* cond  */</span>
      <span class="hl kwa">return</span> <span class="hl kwd">evcond</span><span class="hl sym">(</span>exp<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> env<span class="hl sym">);</span>
    <span class="hl sym">}</span> <span class="hl kwa">else if</span> <span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> define <span class="hl sym">)</span>   <span class="hl com">/* define */</span>
      <span class="hl kwa">return</span> <span class="hl kwd">setf</span><span class="hl sym">(</span> <span class="hl kwd">CADR</span><span class="hl sym">(</span>exp<span class="hl sym">),</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> <span class="hl kwd">CADDR</span><span class="hl sym">(</span>exp<span class="hl sym">),</span> env <span class="hl sym">),</span> env <span class="hl sym">);</span>
    <span class="hl kwa">else if</span> <span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>car <span class="hl sym">==</span> lambda <span class="hl sym">) {</span>
      <span class="hl kwa">return</span> <span class="hl kwd">make_lambda</span><span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> env <span class="hl sym">);</span>
    <span class="hl sym">}</span>
    f <span class="hl sym">=</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> env <span class="hl sym">);</span>
    a <span class="hl sym">=</span> <span class="hl kwd">evlist</span><span class="hl sym">(</span> exp<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> env <span class="hl sym">);</span>
    v <span class="hl sym">=</span> <span class="hl kwd">apply</span><span class="hl sym">(</span> f<span class="hl sym">,</span> a<span class="hl sym">,</span> env <span class="hl sym">);</span>
    <span class="hl kwa">return</span> v<span class="hl sym">;</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">evlist</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>l<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>p<span class="hl sym">;</span>
    <span class="hl kwa">if</span> <span class="hl sym">(</span> l <span class="hl sym">==</span> NULL <span class="hl sym">)</span>
        <span class="hl kwa">return</span> l<span class="hl sym">;</span>
    p <span class="hl sym">=</span> <span class="hl kwa">new</span><span class="hl sym">(</span> Pair <span class="hl sym">);</span>
    p<span class="hl sym">-&gt;</span>car <span class="hl sym">=</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> l<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> env <span class="hl sym">);</span>
    p<span class="hl sym">-&gt;</span>cdr <span class="hl sym">=</span> <span class="hl kwd">evlist</span><span class="hl sym">(</span> l<span class="hl sym">-&gt;</span>cdr<span class="hl sym">,</span> env <span class="hl sym">);</span>
    <span class="hl kwa">return</span> p<span class="hl sym">;</span>
<span class="hl sym">}</span>

Pair <span class="hl sym">*</span><span class="hl kwd">apply</span><span class="hl sym">(</span> Pair <span class="hl sym">*</span>f<span class="hl sym">,</span> Pair <span class="hl sym">*</span>argl<span class="hl sym">,</span> Pair <span class="hl sym">*</span>env <span class="hl sym">)</span>
<span class="hl sym">{</span>
    Pair <span class="hl sym">*</span>v<span class="hl sym">;</span>
    Pair <span class="hl sym">*</span>e1<span class="hl sym">;</span>

    <span class="hl kwa">if</span> <span class="hl sym">(</span> <span class="hl kwd">is_func</span><span class="hl sym">(</span> f <span class="hl sym">) )</span>
        v <span class="hl sym">= (*( (</span>PF<span class="hl sym">)</span> f<span class="hl sym">-&gt;</span>cdr<span class="hl sym">))(</span> argl <span class="hl sym">);</span>
    <span class="hl kwa">else if</span> <span class="hl sym">(</span> <span class="hl kwd">is_lambda</span><span class="hl sym">(</span>f<span class="hl sym">) ) {</span>
        v <span class="hl sym">=</span> <span class="hl kwd">pairlis</span><span class="hl sym">(</span> <span class="hl kwd">CADDR</span><span class="hl sym">(</span>f<span class="hl sym">),</span> argl <span class="hl sym">);</span>
        e1 <span class="hl sym">=</span> <span class="hl kwd">cons</span><span class="hl sym">(</span> v<span class="hl sym">,</span> env <span class="hl sym">);</span>
        <span class="hl kwa">return</span> <span class="hl kwd">eval</span><span class="hl sym">(</span> f<span class="hl sym">-&gt;</span>cdr<span class="hl sym">-&gt;</span>cdr<span class="hl sym">-&gt;</span>cdr<span class="hl sym">-&gt;</span>car<span class="hl sym">,</span> e1 <span class="hl sym">);</span>
    <span class="hl sym">}</span> <span class="hl kwa">else</span>
        <span class="hl kwd">error</span><span class="hl sym">(</span> <span class="hl str">&quot;don't know how to apply function&quot;</span> <span class="hl sym">);</span>
    <span class="hl kwa">return</span> v<span class="hl sym">;</span>
<span class="hl sym">}</span>
</pre>
</body>
</html>
<!--HTML generated by highlight 2.6.14, http://www.andre-simon.de/-->
